home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / program / eflibpt4.zip / DEMO / DATATYPE / QUEUE1.PAS < prev    next >
Pascal/Delphi Source File  |  1996-08-18  |  3KB  |  83 lines
  1. { Borland Pascal Extended Function Library - EFLIB (C) Johan Larsson, 1996
  2.   Demonstration; queues #1
  3.  
  4.   EFLIB IS PROTECTED BY THE COPYRIGHT LAW AND MAY NOT BE COPIED, SOLD OR
  5.   MANIPULATED. FOR MORE INFORMATION, SEE PROGRAM MANUAL! THIS DEMONSTRAT-
  6.   ION PROGRAM MAY FREELY BE USED AND DISTRIBUTED.                          }
  7.  
  8.  
  9. uses EFLIBDEF, EFLIBINI, EFLIBBAS, EFLIBWIN, EFLIBDAT, EFLIBTXT, EFLIBKBD;
  10.  
  11.  
  12. var MyWindow : WindowObjectType;
  13.     MyQueue : QueueObjectType; Data : string[63]; Index : word;
  14.     NumberOfElements : word; StartMemory, MemoryUsed : longint; DataFlow : real;
  15.     RunTimer : TimerObjectType; Intact : boolean;
  16.  
  17.  
  18. begin
  19.      StartMemory := MemAvail; RunTimer.Initialize;
  20.  
  21.      RandSeed := 0; { Control random seed }
  22.  
  23.      with MyWindow do begin
  24.           { Initialize a text window }
  25.           InitializeWindow (1, 1, 80, 25, 'EFLIB', NoBorder, FALSE, FALSE);
  26.           SetTextCoordinates (3, 3, 78, 24);
  27.  
  28.           WriteLn ('@C@@LightGreen:Blue@* Queues *');
  29.           WriteLn ('@C@@White:Blue@All data types have many common features. Queues can be');
  30.           WriteLn ('@C@circular and reversed.');
  31.           WriteLn ('@Yellow:Blue@'); LineFeed;
  32.  
  33.           RunTimer.Reset;
  34.  
  35.           { Build queue }
  36.           WriteLn ('@LightRed:Blue@');
  37.           WriteLn ('Building a queue (adding as many element as memory can keep) ...');
  38.  
  39.           MyQueue.InitializeQueue (SizeOf(Data), { Element size }
  40.                                    TRUE,  { Circular access is enabled }
  41.                                    TRUE); { Skip extra safety checkings }
  42.  
  43.  
  44.           NumberOfElements := 0;
  45.           while MyQueue.IsFree and not GlobalDataError do begin
  46.                 Inc (NumberOfElements);
  47.                 Data := StringGeneratedRandomly (Pred(SizeOf(Data)));
  48.                 MyQueue.Store (Data);
  49.           end;
  50.  
  51.           MemoryUsed := (StartMemory - MemAvail);
  52.  
  53.           WriteLn ('@Yellow:Blue@Cycles through the queue one time and retrieves all elements ... ');
  54.           for Index := 1 to NumberOfElements do MyQueue.Retrieve (Data);
  55.  
  56.           WriteLn ('@LightGreen:Blue@Done.');
  57.           WriteLn ('');
  58.           WriteLn ('');
  59.  
  60.           Intact := MyQueue.IsIntact;
  61.  
  62.           { Intercept object (and dispose all elements from the heap) }
  63.           MyQueue.Intercept;
  64.  
  65.           DataFlow := (MemoryUsed / (1 + RunTimer.ElapsedMS)) * 1e3;
  66.  
  67.           WriteLn ('@White:Blue@DATA FLOW ANALYZIS');
  68.           WriteLn ('@Yellow:Blue@Builded '+StringNumber(NumberOfElements, 0, 0)+' elements at '+
  69.                    StringNumber(RunTimer.ElapsedMS, 0, 0)+' ms, with an average data flow of '+
  70.                    StringNumber(DataFlow, 0, 0));
  71.           WriteLn ('byte per second and a total data allocation of '+StringNumber(MemoryUsed, 0, 0)+' bytes.');
  72.           WriteLn ('');
  73.  
  74.           WriteLn ('@White:Blue@');
  75.           WriteLn ('[Intact]  :  ' + StringBoolean (Intact));
  76.           WriteLn ('[Errors]  :  ' + StringBoolean (GlobalErrorFlag or GlobalDataError));
  77.  
  78.           repeat until Keyboard.KeyPressed;
  79.  
  80.           Intercept;
  81.      end;
  82. end.
  83.